home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #041 (1990)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #041 (1990)(Amiga User Group Deutschland e.V.).adf / VideoMenue / VIME3 (.txt) < prev   
AmigaBASIC Source Code  |  1989-07-02  |  9KB  |  342 lines
  1. REM                   ********************************
  2. REM                   ***  V I D E O   M E N U E   ***
  3. REM                   ***--------------------------***                
  4. REM                   ***   © by  Andreas Hoyer    ***
  5. REM                   ***--------------------------***
  6. REM                   *** Generation3  25-Jul-1989 ***
  7. REM                   ********************************
  8.  
  9. SCREEN 1,640,220,2,2
  10. WINDOW 1,"          VIDEO MENUE   Gen3   © by A.Hoyer    Tue-25-07-1989                  ",,,1
  11. start:
  12. f=0:ON ERROR GOTO fehler
  13. menue:
  14.   CLS
  15.   LOCATE 3,23:PRINT "--===**** VIDEO MENUE ****===--"
  16.   LOCATE 5,23:PRINT "<-1-> .......... Daten eingeben"
  17.   LOCATE 7,23:PRINT "<-2-> .......... Daten anzeigen"
  18.   LOCATE 9,23:PRINT "<-3-> .......... Daten suchen"
  19.   LOCATE 11,23:PRINT "<-4-> .......... Daten ändern"
  20.   LOCATE 13,23:PRINT "<-5-> .......... Daten löschen"
  21.   LOCATE 15,23:PRINT "<-6-> .......... Daten von bis"
  22.   LOCATE 17,23:PRINT "<-7-> .......... Programm Ende"
  23.   LOCATE 20,18:PRINT"Bitte wählen Sie mit der linken Maustaste!"
  24.   LINE (170,12)-(430,138),,b
  25.   LINE (173,14)-(427,24),,b
  26.   LINE (167,10)-(433,140),,b
  27.   LINE (170,122)-(430,124),,b
  28.   FOR a=30 TO 140 STEP 16
  29.     LINE (174,a)-(217,a+10),,b
  30.   NEXT a
  31.  where:
  32.   WHILE 1
  33.   IF MOUSE(0)=0 THEN WEND
  34.   CALL maus(x,y)
  35.   IF x<174 OR x>217 THEN where
  36.   IF y<30 OR y>142 THEN where
  37.   IF x>174 AND x<217 AND y>30 AND y<40 THEN eingeben
  38.   IF x>174 AND x<217 AND y>46 AND y<56 THEN anzeigen
  39.   IF x>174 AND x<217 AND y>62 AND y<72 THEN suchen
  40.   IF x>174 AND x<217 AND y>78 AND y<88 THEN aendern
  41.   IF x>174 AND x<217 AND y>94 AND y<104 THEN killing
  42.   IF x>174 AND x<217 AND y>110 AND y<120 THEN alles
  43.   IF x>174 AND x<217 AND y>126 AND y<136 THEN ende
  44.   GOTO where
  45.  
  46.  
  47. eingeben:
  48.   CLS
  49.   LOCATE 2,3:PRINT "Daten eingeben:":LOCATE 3,3:PRINT "---------------"
  50.   LOCATE 5,5:INPUT "Cassettennummer :";casnu$
  51.     IF casnu$="" THEN menue
  52.   LOCATE 7,5:INPUT "Cassettenlänge E-";e$
  53.     IF e$="" THEN menue
  54.   CLS
  55.   FOR a=1 TO 5
  56.     PRINT
  57.     PRINT " "a". Film:"
  58.     INPUT "  Name : ";nam$(a)
  59.     INPUT "  Dauer: ";tim$(a)
  60.   NEXT a
  61.  
  62.   GOSUB aeok
  63.  
  64.   LOCATE 22,16:PRINT "Noch eine Cassette eingeben?  J  N"
  65.   LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
  66.  nece:
  67.   GOSUB mausa
  68.   IF x<355 OR x>397 THEN nece
  69.   IF y<166 OR y>176 THEN nece
  70.   IF x>355 AND x<375 AND y>166 AND y<176 THEN eingeben
  71.   IF x>375 AND x<397 AND y>166 AND y<176 THEN menue 
  72.   GOTO nece
  73.   
  74. anzeigen:
  75.   CLS
  76.   LOCATE 2,3:PRINT "Daten anzeigen:":LOCATE 3,3:PRINT "---------------"
  77.   LOCATE 5,5:INPUT "Cassettennummer";casnu$
  78.     IF casnu$=""THEN menue
  79.   LOCATE 7,5:PRINT "Einen Moment bitte..."
  80.   
  81.   GOSUB laden
  82.   GOSUB inhalt
  83.  
  84.   LOCATE 22,16:PRINT "Noch eine Cassette anzeigen?  J  N"
  85.   LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
  86.  neca:
  87.   GOSUB mausa
  88.   IF x<355 OR x>397 THEN neca
  89.   IF y<166 OR y>176 THEN neca
  90.   IF x>355 AND x<375 AND y>166 AND y<176 THEN anzeigen
  91.   IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
  92.   GOTO neca
  93.  
  94. aendern:
  95.   CLS
  96.   LOCATE 2,3:PRINT "Daten ändern:":LOCATE 3,3:PRINT "-------------"
  97.   LOCATE 5,5:INPUT "Welche Nummer";casnu$
  98.     IF casnu$="" THEN menue
  99.   LOCATE 7,5:PRINT "Einen Moment bitte..."
  100.   
  101.   GOSUB laden
  102.   GOSUB inhalt
  103. aend: 
  104.   LOCATE 23,5:INPUT "Film ändern (1-5), Cassettenlänge (6) oder Menue (7)";aen
  105.     IF aen<0 OR aen >6 THEN menue
  106.     IF aen=6 THEN caslch
  107.     
  108.   CLS
  109.   PRINT:PRINT "  "a". Film der Cassette ";casnu$;":"
  110.   PRINT:PRINT "   Name:";nam$(aen)
  111.   PRINT "  Dauer:";tim$(aen)
  112.   PRINT:PRINT "Neue Daten:":a=aen
  113.   PRINT:INPUT "   Name:";nam$(a)
  114.   INPUT "  Dauer:";tim$(a)
  115.   GOTO aeneu
  116.           
  117. caslch:
  118.   INPUT "     Cassettenlänge";e$
  119.     IF e$="" THEN caslch
  120.     
  121. aeneu:
  122.   GOSUB inhalt
  123.  
  124. aeok:
  125.   LOCATE 22,20:PRINT "Sind alle Daten richtig?  J  N"
  126.   LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
  127.  chok: 
  128.   GOSUB mausa
  129.   IF x<355 OR x>397 THEN chok
  130.   IF y<166 OR y>176 THEN chok
  131.   IF x>355 AND x<375 AND y>166 AND y<176 THEN speicher
  132.   IF x>375 AND x<397 AND y>166 AND y<176 THEN aend
  133.   GOTO chok
  134.  
  135. killing:
  136.   CLS
  137.   LOCATE 2,3:PRINT "Daten löschen:":LOCATE 3,3:PRINT "--------------"
  138.   LOCATE 5,5:INPUT "Welche Cassette";casnu$
  139.     IF casnu$="" THEN menue
  140.   GOSUB laden
  141.   GOSUB inhalt
  142.   LOCATE 22,28:PRINT "Sind Sie sicher?  J  N"
  143.   LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
  144.  killit:
  145.    GOSUB mausa
  146.    IF x<355 OR x>397 THEN killit
  147.    IF y<166 OR y>176 THEN killit
  148.    IF x>355 AND x<375 AND y>166 AND y<176 THEN killer
  149.    IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
  150.    GOTO killit
  151.    
  152. killer:
  153.   PRINT "  Einen Moment bitte..."
  154.   a$="DATEN/Cass. "+casnu$
  155.   KILL a$
  156.   KILL a$+".info"
  157.   GOTO menue
  158.   
  159. alles:
  160.   CLS
  161.   LOCATE 2,3:PRINT "Daten von bis:":LOCATE 3,3:PRINT "--------------"
  162.   LOCATE 5,5:INPUT "Ab  Cassette";von
  163.     IF von<=0 THEN menue
  164.   LOCATE 7,5:INPUT "bis Cassette";bis
  165.     IF bis <=0 OR bis <von THEN menue
  166.   
  167.   FOR mal=von TO bis
  168.     casnu$=STR$(mal)
  169.     GOSUB lade
  170.     GOSUB inhalt
  171.     LOCATE 22,20:PRINT "Leertaste für weiter, F1 für Menue!"
  172.    show:
  173.      i$=INKEY$
  174.      IF i$=" " THEN showon
  175.      IF i$=CHR$(129) THEN menue
  176.    GOTO show 
  177.  showon:
  178.   NEXT mal
  179.   GOTO menue   
  180.     
  181. laden:
  182.   a$="DATEN/Cass. "+casnu$
  183.   OPEN "I",#1,a$
  184.   FOR a=1 TO 5
  185.     INPUT #1,e$,nam$(a),tim$(a)
  186.   NEXT a
  187.   CLOSE #1
  188.   RETURN
  189.  
  190. lade:
  191.   a$="DATEN/Cass."+casnu$
  192.   OPEN "I",#1,a$
  193.   FOR a=1 TO 5
  194.     INPUT #1,e$,nam$(a),tim$(a)
  195.   NEXT a
  196.   CLOSE #1
  197.   RETURN
  198.     
  199. speicher:
  200.   PRINT:PRINT "  Einen Moment bitte..."
  201.   a$="DATEN/Cass. "+casnu$
  202.   OPEN "O",#1,a$
  203.   FOR a=1 TO 5
  204.     WRITE #1,e$,nam$(a),tim$(a)
  205.   NEXT a
  206.   CLOSE #1
  207.   KILL a$+".info"
  208.   GOTO menue
  209.   
  210. speichern:
  211.   PRINT:PRINT "  Einen Moment bitte..."
  212.   a$="DATEN/Cass. "+casnu$
  213.   OPEN "O",#1,a$
  214.   FOR a=1 TO 5
  215.     WRITE #1,e$,nam$(a),tim$(a)
  216.   NEXT a
  217.   CLOSE #1
  218.   KILL a$+".info"
  219.   RETURN
  220.   
  221. inhalt:
  222.   CLS:LOCATE 1,20:PRINT "Inhalt von Cassette ";casnu$;" (E-";e$;")"
  223.   FOR a=1 TO 5
  224.     PRINT
  225.     PRINT "  "a". Film:"
  226.     PRINT "   Name : ";nam$(a)
  227.     PRINT "   Dauer: ";tim$(a)
  228.   NEXT a
  229.   RETURN
  230.     
  231. mausa:
  232.   WHILE 1
  233.   IF MOUSE(0)=0 THEN WEND
  234.   CALL maus(x,y)
  235.   RETURN
  236.   
  237. ende:
  238.   LOCATE 22,28:PRINT "Sind Sie sicher?  J  N"
  239.   LINE (355,166)-(397,176),,b:LINE (375,166)-(375,176)
  240.  rett:
  241.   WHILE 1
  242.   v=MOUSE(0)
  243.   IF MOUSE(0)=0 THEN WEND
  244.   CALL maus(x,y)
  245.   IF x<355 OR x>397 THEN rett
  246.   IF y<166 OR y>176 THEN rett
  247.   IF x>355 AND x<375 AND y>166 AND y<176 THEN aus
  248.   IF x>375 AND x<397 AND y>166 AND y<176 THEN menue
  249.   GOTO rett
  250.  
  251.  
  252. fehler:
  253.   IF ERR=61 THEN RESUME full            :REM Disk is full
  254.   IF ERR=53 AND f=1 THEN RESUME nichts  :REM Film existiert nicht
  255.   IF ERR=53 AND f=2 THEN RESUME keinec  :REM Cassette existiert nicht
  256.   IF ERR=53 THEN RESUME finf            :REM file not found
  257.   IF ERR=70 THEN RESUME writ            :REM Disk is write protectet
  258.   END
  259.  
  260. full:
  261.   CLS:BEEP
  262.   LOCATE 5,5:PRINT "Die Diskette ist zu voll um die letzten Daten noch zu speichern!"
  263.   LOCATE 7,5:PRINT "Bitte legen Sie eine andere Diskette mit einem 'DATEN' Directory"
  264.   LOCATE 9,5:PRINT "in das von Ihnen benützte Laufwerk!"
  265.   LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste, wenn Sie die Disketten gewechselt haben!"
  266.  fullw:
  267.   i$=INKEY$
  268.   IF i$=" " THEN GOTO start
  269.   GOTO fullw:
  270.   
  271. finf:
  272.   CLS:BEEP
  273.   LOCATE 5,5:PRINT "Auf dieser Diskette befindet sich keine Datei mit diesem Namen!"
  274.   LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste um das Programm weiterzuführen!"
  275.  finfw:
  276.   i$=INKEY$
  277.   IF i$=" " THEN GOTO start
  278.   GOTO finfw:
  279.  
  280. writ:
  281.   CLS:BEEP
  282.   LOCATE 5,5:PRINT "   Diese Diskette ist Schreibgeschützt, es können keine Daten"
  283.   LOCATE 7,5:PRINT "darauf abgespeichert werden. Bitte entfernen Sie den Schreibschutz."
  284.   LOCATE 15,5:PRINT"Drücken Sie auf die Leertaste um das Programm weiterzuführen!"
  285.  writw:
  286.   i$=INKEY$
  287.   IF i$=" " THEN GOTO start
  288.   GOTO writw:
  289.  
  290. suchen:
  291.   CLS
  292.   LOCATE 1,3:PRINT "Daten suchen"
  293.   LOCATE 2,3:PRINT "------------"
  294.   LOCATE 4,5:INPUT "Welchen Film suchen ";fina$
  295.     IF fina$=""THEN menue
  296.   LOCATE 6,5:INPUT "Ab welcher Cassette ";cas
  297.     IF cas<1 THEN menue
  298.   LOCATE 8,5:PRINT "BITTE WARTEN ..."
  299.   LOCATE 10,5:PRINT "Ich suche auf Cassette :"
  300.  
  301.  REM ---***  500 ist die maximale Zahl der VCassetten ***---
  302.   
  303.   FOR s=cas TO 500
  304.     
  305.     f=1:LOCATE 10,30:PRINT s
  306.     a$="DATEN/Cass."+STR$(s)
  307.     OPEN "I",#1,a$
  308.     FOR a=1 TO 5
  309.     INPUT #1,e$,nam$(a),tim$(a)
  310.       IF nam$(a) = fina$ THEN gefunden
  311.     NEXT a
  312.     CLOSE #1
  313.   NEXT s
  314.  
  315. nichts:
  316.   CLS:BEEP:LOCATE 5,20:PRINT "Leider wurde der Film nicht gefunden!"
  317.   FOR z=1 TO 5000:NEXT
  318.   GOTO menue
  319.   
  320. keinec:
  321.   CLS:BEEP:LOCATE 5,23:PRINT "Diese Cassette existiert nicht !"
  322.   FOR z=1 TO 5000:NEXT
  323.   GOTO menue
  324.   
  325. gefunden:
  326.   CLS:BEEP
  327.   LOCATE 5,5:PRINT nam$(a);" ist der"
  328.   LOCATE 7,5:PRINT a". Film auf Cassette ";s;" (E-";e$;")"
  329.   LOCATE 9,5:PRINT "und dauert ";tim$(a);"."
  330.   LOCATE 20,25:PRINT "LEERTASTE für Menü!"
  331.  gef:
  332.    i$=INKEY$:IF i$<>" " THEN gef
  333.    RUN                           :REM WICHTIG !!!
  334. SUB maus(x,y) STATIC
  335. x= MOUSE(1)
  336. y= MOUSE(2)
  337. END SUB
  338.    
  339. aus:
  340.   CLS
  341.   SYSTEM
  342.